home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
you-075a.lha
/
you-075a
/
interpret.h
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-15
|
6KB
|
247 lines
/*
* Defines of bytecode junk
*/
#ifndef _INTERPRET_H
#define _INTERPRET_H
/*****************************************/
/* For debugging */
#ifndef NODEBUG
#define BC_BUG(x) x
#define BC_BUG_EXP(x) x
#else
#define BC_BUG(x)
#define BC_BUG_EXP(x) 0
#endif
#ifndef NODEBUG
#define VCHECK(x) \
(( (x)!=NULL && (((int) (x))&1==1)) \
? CallError(sp,"Dumb value",nil,NONCONTINUABLE) \
: nil)
#else
#define VCHECK(x) 0
#endif
#ifdef COUNT_BYTES
#define BC_COUNTER(x) x
#else
#define BC_COUNTER(x)
#endif
#define BC_PRESWITCH() \
BC_BUG({ \
fprintf(stderr,"{Doing: [%x, %x, %d] %d}\n",pc,sp,(int) (sp-oldsp),*pc); \
oldsp=sp; \
}) \
BC_COUNTER(exec_counts[*pc]++);
/* Global reference */
#define GLOB_REF(n,m) \
vref(statics[n],m)
/* Stack hacking */
#define NTH_REF(sp,n) (*((sp)-(n)))
#define SET_NTH_REF(sp,n,v) (*((sp)-(n))=v)
#define PUSH_VAL(sp,val) ((*(++sp)=val))
#define POP_VALS(sp,n) ((sp) -= (n))
#define PEEK_VAL(sp) (*(sp))
#define TOP_VAL(sp) (*(sp--))
#define SHOVE_VAL(sp,val) ((*(sp))=val)
#define SET_STACK(sp,val) (sp)=(val);
/* Environment hacking */
#define ENV_NTH(e,depth) \
counter=depth; \
while (counter) \
{ \
e=vref(e,0); \
counter--; \
VCHECK(e); \
}
#define ENV_REF(e,into,depth,dist) \
ENV_NTH(e,depth) \
into=vref(e,dist+1);
#define SET_ENV_REF(e,depth,dist,val) \
ENV_NTH(e,depth) \
vref(e,dist+1)=val;
#define MAKE_ENV(sp,size) \
{ \
LispObject tmp; \
/**/ \
tmp=allocate_vector(sp+1, size+1); \
vref(tmp,0)= PEEK_VAL(sp); \
SHOVE_VAL(sp,tmp); \
}
/******************************/
/* instruction stream hacking */
typedef unsigned char bytecode;
/* shoves arg into 'into' and updates pc */
/* Should be a bit (read lots) cleverer */
#define read_int_arg(into,stream) \
into= (int)(*(stream++)); \
into=(into<<8)+((int)(*(stream++))); \
into=(into<<8)+((int)(*(stream++))); \
into= *(stream++) ? -into: into; \
BC_BUG(fprintf(stderr,"Read int: got: %d [%x]\n", into,into));
#define read_short_arg(into,stream) /* NOT YET */ \
into=1; stream+=2;
#define read_sign_arg(into,stream) \
into=(int)((char) *(stream++));
#define read_byte_arg(into,stream) \
into = *(stream++);
#define skip_int_arg(pc) pc+=sizeof(int)
#define next(stream) stream++;
#define INC_PC(pc) (pc++)
/* representation of BC on stack */
#define PC_VAL_WIDTH 20
#define PC_FLAG_WIDTH 2
#define PC_FLAG 3
#define PC_VECT_MASK ((1<<(PC_VAL_WIDTH+PC_FLAG_WIDTH)) - 1)
#define bytevector_start(vector_number) (bytevectors[vector_number])
#define REIFY_PC(pc) \
((LispObject) \
((this_vector<<(PC_VAL_WIDTH+PC_FLAG_WIDTH)) \
| (((pc)-bytevector_start(this_vector)) << PC_FLAG_WIDTH) \
| PC_FLAG))
#define SET_PC(this_vector,reified_pc) \
((this_vector=((int)reified_pc)>>(PC_VAL_WIDTH+PC_FLAG_WIDTH)), \
BC_BUG_EXP((this_vector==32 || this_vector==0) ? 0 : perror("wibble3")),\
reified_pc=((LispObject) (((int)(reified_pc))&PC_VECT_MASK)), \
bytevector_start(this_vector)+((((int)reified_pc)>>PC_FLAG_WIDTH)) \
)
/* modifies pc by x bytes */
#define ADJUST_PC(pc,x) \
((pc)+((x)-1))
#define BF2PC(x) \
(this_vector=intval(bytefunction_codenum(x)), \
BC_BUG_EXP(this_vector<=32 ? 0 : perror("wibble2")), \
bytevector_start(intval(bytefunction_codenum(x))) \
+intval(bytefunction_offset(x)))
/* Move sp to the start of a new nary list */
/**********************/
/* Garbage protection */
#define GC_RESTORE_GLOBALS \
{ \
if (1) \
{ \
BCnil=nil; \
BCtrue=lisptrue; \
} \
}
/* Printing counts ... */
#ifdef COUNT_BYTES
#define PRINT_COUNTS \
{ \
int i,j; \
for (i=0, j=0; i<256; i++) \
{ \
if (exec_counts[i]!=0) \
{ \
fprintf(stderr,"%3d: %7d ",i,exec_counts[i]); \
j++; \
if ( (j%6) == 0) \
fputc('\n',stderr); \
} \
} \
if (j%6!=0) fputc('\n',stderr); \
}
#else
#define PRINT_COUNTS fprintf(stderr,"Count-bytes: Couldn't tell you\n");
#endif
/*****************************************/
/* Interpreter macros */
#define MAX_MODS 256
#ifdef __STDC__
# ifndef NODEBUG
# define BC_CASE(name) \
case name: fprintf(stderr,"{Exec: "#name" [%x]}",(int)name,(int)pc); name##_CODE break;
# else
# define BC_CASE(name)\
case name: name##_CODE break;
# endif
#else /* stdc */
# ifndef NODEBUG
# define BC_CASE(name) \
case name: fprintf(stderr,"{Exec: name [%x]}",(int)name,(int)pc); name/**/_CODE break;
# else
# define BC_CASE(name) \
case name: name/**/_CODE \
break
# endif
#endif
#define N_GLOBALS 10
#define GLOBAL_REF(n) vref(global_vector,(n))
#define Generic_Lookup_Fn 0
#define Generic_Apply_Fn 1
#define Bci_Protect_Slot 2
#define BC_GLOBALS() \
static LispObject boot_modules[MAX_BOOT_MODULES]; \
static int boot_module_count=1; \
static bytecode exit_bytes[] = { BC_EXIT }; \
static SYSTEM_GLOBAL(int,static_count); \
static LispObject *statics; \
static LispObject static_vectors; \
static LispObject global_vector;
/**/ \
static bytecode **bytevectors; \
BC_BUG(static LispObject *oldsp;) \
BC_COUNTER(static int exec_counts[256];) \
#define BC_INITIALISE_GLOBALS() \
BCnil=nil; \
BCtrue=lisptrue; \
BC_BUG(oldsp=sp); \
sp=stacktop-1; /* stackpointer[0]= top elt */ \
pc=start_pc; \
this_vector=context; \
#define BC_NOINSTRUCT(pc) \
default: \
fprintf(stderr,"No such instruction: %d\n",pc);
/* GC Protection */
#define SAVE_REGISTERS(sp)
#define RESTORE_REGISTERS(sp)
#endif _INTERPRET_H